home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
BASIC
/
0007.ZIP
/
PAK-DATE.BAS
< prev
next >
Wrap
BASIC Source File
|
1983-12-12
|
2KB
|
33 lines
10 ' DATPAK.BAS Written by Kurt Riegel, Arlington VA (703-522-5427) Oct 1983
20 ' These subroutines can pack a 6 byte date into a 2 byte integer, and
30 ' then unpack the integer to restore the original date. They are useful for
40 ' saving space in memory and disk for date intensive data.
50 ' The first section shows how to call the pack & unpack routines.
60 ' Input dates are of the form D$ = "YYMMDD"
70 ' Output dates are of the form ND% = simple 2 byte integer
80 ' You are responsible for assuring that the input date is sensible. For example, 830231 is returned as 830231; 830333 is returned as 830402.
90 ' Date range is 010102 to 991231 -- modify for dates not in 20th century.
100 'The variables D$, ND%, and M$ are modified by these routines--change their names if they will clobber your own variables in your calling program.
110 '
120 '
130 '
140 PRINT TAB(9)"date in"TAB(25)"integer out"TAB(40)"date out" 'Calling section
150 INPUT"yymmdd";D$:PRINT TAB(9)D$;
160 GOSUB 220:PRINT TAB(25)ND%;:GOSUB 280:PRINT TAB(40)D$:GOTO 150
170 '
180 '
190 'This subroutine packs a 6 byte date D$ into a 2 byte integer ND%
200 'Call by providing date D$="YYMMDD", GOSUB 220. ND% is returned.
210 'Only the variable ND% is modified by this section
220 ND%=((VAL(LEFT$(D$,2))-80)*12+VAL(MID$(D$,3,2))-1)*31+VAL(RIGHT$(D$,2))-1:RETURN
230 '
240 '
250 'This subroutine unpacks a 2 byte integer ND% into a 6 byte date D$.
260 'Call by providing integer ND% created above, GOSUB 280. D$ is returned.
270 'Only the variables D$ and M$ are modified by this section
280 D$=STR$(80+ND%\372+(ND%<0)):D$=RIGHT$("0"+RIGHT$(D$,LEN(D$)-1),2)
290 ND%= (372+ND% MOD 372) MOD 372:M$=STR$(1+ND%\31):M$=RIGHT$(M$,LEN(M$)-1)
300 D$=D$+RIGHT$("00"+M$,2)
310 ND%= (31+ND% MOD 31) MOD 31:M$=STR$(1+ND%):M$=RIGHT$(M$,LEN(M$)-1)
320 D$=RIGHT$(D$+RIGHT$("00"+M$,2),6):RETURN